home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / surfsrc3.zip / GETONE.INC < prev    next >
Text File  |  1991-09-07  |  2KB  |  67 lines
  1. { GETONEREAL and GETONEINT: Two functions that do the same thing.
  2.   They both print a prompt and the old value of the variable, and
  3.   request a new value from the user.  If the user just hits ENTER,
  4.   then the old value is returned.  If he types in a legitimate value
  5.   (i.e., it is numeric and in the range Loval to Hival), then the
  6.   new value is returned.  If an invalid entry is made, he is given
  7.   an error message and prompted to retype.
  8. }
  9.  
  10. function GETONEREAL (Oldval, Loval, Hival: real; Prompt: text80): real;
  11. var Num:     integer;        { number of values read }
  12.     Realvar: vartype;        { variables from input }
  13.     Comment: text80;         { user's comment (unused) }
  14.     Cmmd:    cmmdtype;
  15.     Parm:    parmtype;
  16.     Line_num:integer;
  17.  
  18. begin
  19.   Num := -1;
  20.   Line_num := -1;
  21.   while (Num <> 0) and (Num <> 1) do begin
  22.     write ('Enter ', Prompt, ' ( ', Oldval:7:3, ' ) = ');
  23.     Num := inreal (Input, Realvar, Comment, Cmmd, Parm, Line_num, TRUE);
  24.     if (Num = 1) then begin
  25.       if (Realvar[1] < Loval) or (Realvar[1] > Hival) then begin
  26.         writeln ('Error: Input must be in range ', Loval:7:3, ' to ',
  27.                  Hival:7:3);
  28.         Num := -1;
  29.       end;
  30.     end else if (Num <> 0) then
  31.       writeln ('Error: Expecting one numeric input.');
  32.   end; { while }
  33.   if (Num = 1) then
  34.     Getonereal := Realvar[1]
  35.   else
  36.     Getonereal := Oldval;
  37. end; { function GETONEREAL }
  38.  
  39. function GETONEINT (Oldval, Loval, Hival: integer; Prompt: text80): integer;
  40. var Num:     integer;        { number of values read }
  41.     Realvar: vartype;        { variables from input }
  42.     Comment: text80;         { user's comment (unused) }
  43.     Cmmd:    cmmdtype;
  44.     Parm:    parmtype;
  45.     Line_num:integer;
  46.  
  47. begin
  48.   Num := -1;
  49.   Line_num := -1;
  50.   while (Num <> 0) and (Num <> 1) do begin
  51.     write ('Enter ', Prompt, ' ( ', Oldval, ' ) = ');
  52.     Num := inreal (Input, Realvar, Comment, Cmmd, Parm, Line_num, TRUE);
  53.     if (Num = 1) then begin
  54.       if (Realvar[1] < Loval) or (Realvar[1] > Hival) then begin
  55.         writeln ('Error: Input must be in range ', Loval, ' to ', Hival);
  56.         Num := -1;
  57.       end;
  58.     end else if (Num <> 0) then
  59.       writeln ('Error: Expecting one numeric input.');
  60.   end; { while }
  61.   if (Num = 1) then
  62.     Getoneint := round (Realvar[1])
  63.   else
  64.     Getoneint := Oldval;
  65. end; { function GETONEINT }
  66. 
  67.